home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / editno.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1984-04-24  |  3.6 KB  |  77 lines
  1. 1000  ' Numeric Editing routines for PC Basic-Basica
  2. 1010  ' Michael Krieger, June 1983
  3. 1020  '
  4. 1030  ' The purpose of these three subroutines is to perform numeric editing
  5. 1040  ' especially for DATE and TIME fields, which CAN NOT be edited
  6. 1050  ' with "PRINT USING".  They are just string manipulation routines
  7. 1060  ' which run very fast, and will take your number and return a nice
  8. 1070  ' edited string of a FIXED LENGTH for you to use to make output
  9. 1080  ' more legible.
  10. 1090  '
  11. 1100  ' *** FIELD NAMES USED BY THESE ROUTINES
  12. 1105  '     NAME    SET BY       DESCRIPTION
  13. 1106  '
  14. 1110  '     A2      user         Field to be edited
  15. 1120  '     ISIG    user         Number of significant places desired
  16. 1130  '                          (left of decimal point)
  17. 1140  '     IDEC    user         No. of Decimal positions desired in result
  18. 1150  '                          (to RIGHT of decimal point)
  19. 1160  '     DLM$    user         DELIMITER desired ("/", ":", "-", etc)
  20. 1180  '     LPAD$   user         Left Pad Character (" ","0","$", etc.)
  21. 1190  '     O$      routine      THE EDITED STRING !!
  22. 1200  '
  23. 1210  '
  24. 1220  ' The length of the returned string will be the total of ISIG plus
  25. 1230  ' IDEC plus 1 for decimal point, plus 1 for trailing minus sign, which
  26. 1240  ' will be added if the field is negative.
  27. 1250  '
  28. 1260  ' ** TO USE THE ROUTINES **
  29. 1270  ' 1. first, if the number is to be rounded off, store your field into
  30. 1280  '    A2 and GOSUB 1670 (or whatever you renumber it to)
  31. 1290  '
  32. 1300  ' 2. Next, set ISIG, IDEC, DLM$, and LPAD$ to the values you want.
  33. 1310  '    for a normal DATE field, this would be:
  34. 1320  '    ISIG=6:IDEC=0:DLM$="/":LPAD$=" "
  35. 1330  ' 3. GOSUB to the JUSTIFICATION routine with GOSUB 1730.
  36. 1340  ' 4. To complete the DATE/TIME edit, GOSUB 1600 to insert the delimiter
  37. 1350  '    characters.
  38. 1360  '
  39. 1370  '  ***** END OF NARRATIVE==== BEGIN SUBROUTINE CODE==
  40. 1380  '  You may delete all lines up to here before using the code.
  41. 1390  '  HAPPY EDITING!!!!!
  42. 1600  ' ************* NUMERIC EDITING SUBROUTINE FOR DATE & TIME
  43. 1610  '
  44. 1620  B$=O$ ' SET UP THE WORK STRING
  45. 1630  O$=LEFT$(B$,2)+DLM$+MID$(B$,3,2):IF LEN(B$) > 5 THEN O$=O$+DLM$+MID$(B$,5,2) ' COMPLETE FOR DATE
  46. 1650  RETURN
  47. 1660  '
  48. 1670  ' ********* R O U N D O F F     S U B R O U T I N E *****************
  49. 1680  IRFCT=1:IF IDEC <=0 THEN RETURN ' NO ROUNDOFF FOR INTEGERS
  50. 1690  FOR IWXI=1 TO IDEC: IRFCT=IRFCT * 10: NEXT
  51. 1700  A2=INT((A2+ (0.5*(1/IRFCT)))*IRFCT)/IRFCT : RETURN
  52. 1710  '
  53. 1720  '
  54. 1730  ' *********** NUMERIC LEFT & RIGHT JUSTIFICATION ********************
  55. 1735  '
  56. 1740  ID=1:IS1=0:ID1=0:B2$="":INEG=0:IF A2<=0 THEN INEG=-1:A2=ABS(A2) ' SET PARMS & SIGN
  57. 1750  B$=STR$(A2):B$=RIGHT$(B$,(LEN(B$)-1)) ' STRIP THE FIRST BLANK.
  58. 1760  FOR IWX1=1 TO LEN(B$): IF MID$(B$,IWX1,1)="." THEN ID=3 ' DEC POINT FOUND
  59. 1770  ON ID GOTO 1780,1790,1800
  60. 1780  IS1=IS1+1:GOTO 1810
  61. 1790  ID1=ID1+1:GOTO 1810
  62. 1800  ID=2
  63. 1810  NEXT
  64. 1830  IWX1=1:IWX2=2:IF IS1>=ISIG THEN 1870 ' PAD LEFT
  65. 1840  FOR IWX1=1 TO ISIG-IS1:B2$=B2$+LPAD$:IWX2=IWX2+1:NEXT ' BEGIN STRING WITH THE PADS.
  66. 1850  IF LPAD$<>"$" OR IWX2<2 THEN 1870 ' BYPASS DOLLAR SIGN BLANKOUT.
  67. 1860  FOR IWX1=1 TO IWX2-1:MID$(B2$,IWX1,1)=" ":NEXT ' BLANK OUT THE $ IN STRING
  68. 1870  B2$=B2$+B$: IF ID1>=IDEC THEN 1900 ' DECIMAL PLACES NEED PADDING ?
  69. 1880  IF ID1=0 THEN B2$=B2$+"." ' ADD THE DEC POINT
  70. 1890  FOR IWX1=LEN(B2$)+1 TO LEN(B2$)+(IDEC-ID1):B2$=B2$+"0":NEXT
  71. 1900  IF NEG THEN B2$=B2$+"-" ELSE B2$=B2$+" " ' TRAIL A BLANK OR A MINUS SIGN.
  72. 1910  O$=B2$: RETURN '       END OF *** JUSTIFY *** ROUTINE
  73. 1920  ' ********************** END OF EDITING ROUTINES ******************
  74. 1930  '  If you have any questions or are confused,
  75. 1940  '  leave EMAIL for me, Michael Krieger at 74065,1344
  76. 1950  '  or call at (212) 741 2828  or (516) 883 7016
  77.